home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / smaltalk / manchest.lha / MANCHESTER / manchester / 4.1 / SunFunKeys.st < prev    next >
Text File  |  1993-07-24  |  18KB  |  530 lines
  1. "    NAME        SunFunKeys4.1
  2.     AUTHOR        Markus Geltz, Alan Wills, Mario Wolczko
  3.     FUNCTION    Binds functions to keys on the SUN type-4 keyboard
  4.     ST-VERSION    4.1
  5.     PREREQUISITES    
  6.     CONFLICTS
  7.     DISTRIBUTION     world
  8.     VERSION        4
  9.     DATE    28 May 1993
  10. SUMMARY
  11. This goodie binds various function keys appropriately on the Sun Type 4 
  12. keyboard.  Other keyboards can be handled with small modifications.
  13. A text search feature is also included.
  14.  
  15. The bindings are:
  16.     Again(L2), Undo(L4), Copy(L6), Paste(L8), Cut(L10): as you'd expect.
  17.     Find(L9): 
  18.         if there is a selection, finds its next occurrence;
  19.         othewise, finds a string as you type it
  20.             --- any non-printing key gets out of this mode.
  21.         Two successive L9's look for the most recently found string.
  22.     Enter:    Accept
  23.     Home(R7): beginning of line; End(R13): end of line.
  24.     PgUp(R9), PgDn(R15): prior and next pages.
  25.     R1, R2, R3: do it, print it, inspect it.
  26.     LineFeed: newline and copy indentation from previous line.
  27.     Help: tells you the Smalltalk code and binding for the next keystroke.
  28.  
  29. It should be obvious how to bind other keys following this scheme.
  30. In general:
  31. 1. Ensure that your window system is mapping the key to a key symbol.
  32.    Use the Help key as above, or use 'KBMonitor open'.
  33.    If not, use xmodmap to achieve the mapping.  xev is a useful program for
  34.    finding which keycode is generated by a key. 
  35.    Names of X11 keysyms can usually be found in /usr/include/X11/keysymdef.h
  36.    and InputState class>initKeys. 
  37. 2. Add a suitable line to ParagraphEditor>initializeSUNkeys to associate the keysym
  38.    with a method.  Write the method if necessary.
  39. 3. Reinitialize ParagraphEditor.  New windows will use the new mapping.
  40. "!
  41.  
  42. 'From Objectworks\Smalltalk(R), Release 4.1 of 15 April 1992 on 27 May 1993 at 2:47:43 am'!
  43.  
  44. ControllerWithMenu subclass: #ParagraphEditor
  45.     instanceVariableNames: 'beginTypeInIndex emphasisHere dispatchTable charComposer textHasChanged '
  46.     classVariableNames: 'CodeYellowButtonMenu CompilationErrorSignal Keyboard MostRecentSearchString PreviousSelections TextEditorYellowButtonMenu UndoSelection '
  47.     poolDictionaries: 'TextConstants '
  48.     category: 'Interface-Text'!
  49.  
  50.  
  51. !ParagraphEditor methodsFor: 'editing'!
  52.  
  53. againKey: aChar
  54.     "Repeat the last edit"
  55.  
  56.     self again!
  57.  
  58. beginOfTextKey: aChar
  59.     ".Creator: Markus Geltz        Last Modified:  24 October 1991  6:08:41 pm."
  60.     "set the carat to the begin of the text"
  61.  
  62.     self selectionStartIndex: 1.
  63.     self selectionStopIndex: 1.
  64.     view selectAndScroll. 
  65.     ^ true!
  66.  
  67. copySelectionKey: aChar
  68.     "Copy the current text selection."
  69.  
  70.     self copySelection!
  71.  
  72. deleteBackwardWordKey: aChar  
  73.     ".Creator: Markus Geltz        Last Modified:  17 September 1991  1:44:25 pm."
  74.     "delete one word backward"
  75.  
  76.     | wordIndices start |
  77.     self selectionStopIndex: (start := self selectionStartIndex).
  78.     start > 1 ifFalse: [^ true].
  79.     wordIndices := self getWordBoundsWithIndex: start direction: #back.
  80.     self selectionStartIndex: wordIndices first.
  81.     self cut.
  82.     view selectAndScroll.
  83.     ^true!
  84.  
  85. deleteForwardCharKey: aChar  
  86.     ".Creator: Markus Geltz        Last Modified:  17 September 1991  4:35:22 pm."
  87.     "delete one character forward"
  88.  
  89.     | stopIndex |
  90.     self resetTypein.
  91.     stopIndex := self text size min: self selectionStopIndex + 1.
  92.     self selectionStopIndex: stopIndex.
  93.     self replaceSelectionWith: Text new.!
  94.  
  95. deleteForwardWordKey: aChar  
  96.     ".Creator: Markus Geltz        Last Modified:  17 September 1991  1:44:34 pm."
  97.     "delete one word forward"
  98.  
  99.     | wordIndices start |
  100.     self selectionStopIndex: (start := self selectionStartIndex).
  101.     start < self text size ifFalse: [^ true].
  102.     wordIndices := self getWordBoundsWithIndex: start direction: #for.
  103.     self selectionStopIndex: wordIndices last.
  104.     self cut.
  105.     view selectAndScroll.
  106.     ^true!
  107.  
  108. doItKey: aChar
  109.     self doIt!
  110.  
  111. echoInputKey: aCharEvent
  112.     "A bizarre character has been received: echo its value to the Transcript, but ignore it otherwise."
  113.  
  114.     Transcript show: 'Unknown key: ',aCharEvent keyValue printString; cr.
  115.     self ignoreInputKey: aCharEvent!
  116.  
  117. endOfTextKey: aChar
  118.     ".Creator: Markus Geltz        Last Modified:  24 October 1991  6:11:06 pm."
  119.     "set the carat to the begin of the text"
  120.  
  121.     | size |
  122.     size := self text size + 1.
  123.     self selectionStartIndex: size.
  124.     self selectionStopIndex: size.
  125.     view selectAndScroll. 
  126.     ^ true!
  127.  
  128. findEndKey: aChar
  129.     "A funny key during a search --- see findKey:"
  130.     self selectionStopIndex = self selectionStartIndex
  131.             ifTrue: [ aChar keyValue = #L9
  132.                     ifTrue: [self findAndSelect: MostRecentSearchString.
  133.                             self selectionStopIndex = self selectionStartIndex
  134.                             ifTrue: [self selectionStopIndex: 1.
  135.                                     self selectionStartIndex: 1.
  136.                                     self findAndSelect: MostRecentSearchString]    ]]
  137.             ifFalse:[MostRecentSearchString := self selection asString].
  138.     dispatchTable := nil "will revert to default"!
  139.  
  140. findExtendKey: aChar
  141.     "In the middle of a search --- see findeKey"
  142.     | sti |
  143.     sti := self selectionStopIndex.
  144.     (self text size < sti ifTrue: [nil] ifFalse: [self text at: sti]) = aChar keyValue
  145.         ifTrue: [self selectFrom: self selectionStartIndex to: sti]
  146.         ifFalse: [    self findAndSelect: (self selection asString copyWith: aChar keyValue)]!
  147.  
  148. findKey: aChar
  149.     "Search for the next occurrence of the string under the cursor"
  150.     "Alan Wills <alan@cs.man.ac.uk>"
  151.     | ss |
  152. self searchKey: aChar
  153.     "ss := self selectionStartIndex. 
  154.     ss = self selectionStopIndex
  155.         ifTrue: [    dispatchTable := DispatchTable new.
  156.                 dispatchTable defaultForCharacters: #findExtendKey: ;
  157.                                 defaultForNonCharacters: #findEndKey: ]
  158.         ifFalse: [ self findAndSelect: (MostRecentSearchString := self selection asString).
  159.                 ss = self selectionStartIndex ifTrue: [
  160.                         self selectFrom: 1 to: 0.
  161.                         self findAndSelect: MostRecentSearchString]]"!
  162.  
  163. searchKey: c
  164.     | ss sti done |
  165.     ss := self selectionStartIndex. 
  166.     ss = self selectionStopIndex
  167.         ifFalse: [self findAndSelect: (MostRecentSearchString := self selection asString).
  168.                 ss = self selectionStartIndex ifTrue: [
  169.                         self selectFrom: 1 to: 0.
  170.                         self findAndSelect: MostRecentSearchString]]
  171.         ifTrue: [ Cursor crossHair showWhile: [
  172.                     [done isNil & self viewHasCursor and: [self sensor anyButtonPressed not]] whileTrue: [
  173.                     self dispatchTable add: self sensor keyboardEvent do: [
  174.                         :cev :sel | 
  175.                         sel == #normalCharacterKey:
  176.                             ifTrue: [    
  177.                                     sti := self selectionStopIndex.
  178.                                     (self text size < sti ifTrue: [nil] ifFalse: [self text at: sti]) = cev keyValue
  179.                                         ifTrue: [self selectFrom: self selectionStartIndex to: sti]
  180.                                         ifFalse: [    self findAndSelect: (self selection asString copyWith: cev keyValue)]]
  181.                             ifFalse: [self selectionStopIndex = self selectionStartIndex
  182.                                             ifTrue: [ cev keyValue = #L9
  183.                                                     ifTrue: [self findAndSelect: MostRecentSearchString ]]
  184.                                             ifFalse:[MostRecentSearchString := self selection asString].
  185.                                     done := true] ]] ] ] !
  186.  
  187. flipChars: aStream key: aChar
  188.     ".Creator: Markus Geltz        Last Modified:  29 October 1991  5:04:25 pm."
  189.     "flip the two characters before and after the caret"
  190.  
  191.     | before after ind |
  192.     (ind :=self selectionStartIndex) = self selectionStopIndex
  193.         ifFalse: [^ true].
  194.     self selectionStartIndex: ind - 1.
  195.     before := (paragraph characterBlockForIndex: ind - 1) character.
  196.     after := (paragraph characterBlockForIndex: ind) character.
  197.     self replaceFrom: ind - 1 to: ind with: (Text fromString: after asSymbol , before asSymbol).
  198.         self selectionStartIndex: ind.
  199.     view selectAndScroll.
  200.     ^ true!
  201.  
  202. flipCharsKey: aChar
  203.     ".Creator: Markus Geltz        Last Modified:  29 October 1991  5:04:25 pm."
  204.     "flip the two characters before and after the caret"
  205.  
  206.     | before after ind |
  207.     (ind :=self selectionStartIndex) = self selectionStopIndex
  208.         ifFalse: [^ true].
  209.     self selectionStartIndex: ind - 1.
  210.     before := self text at: ind - 1.
  211.     after := self text at: ind.
  212.     self replaceFrom: ind - 1 to: ind with: (Text fromString: after asSymbol , before asSymbol).
  213.         self selectionStartIndex: ind.
  214.     view selectAndScroll.
  215.     ^ true!
  216.  
  217. forwardWord: characterStream key: aChar 
  218.     ".Creator: Markus Geltz        Last Modified:  17 September 1991  1:44:47 pm."
  219.     "set Cursor one word forward"
  220.  
  221.     | wordIndices start |
  222.     start := self selectionStartIndex.
  223.     start < paragraph string size ifFalse: [^ true].
  224.     wordIndices := self getWordBoundsWithIndex: start direction: #for.
  225.     self selectionStartIndex: wordIndices last.
  226.     self selectionStopIndex: wordIndices last.
  227.     view selectAndScroll.
  228.     ^true!
  229.  
  230. forwardWordKey: aChar 
  231.     ".Creator: Markus Geltz        Last Modified:  17 September 1991  1:44:47 pm."
  232.     "set Cursor one word forward"
  233.  
  234.     | wordIndices start |
  235.     start := self selectionStartIndex.
  236.     start < self text size ifFalse: [^ true].
  237.     wordIndices := self getWordBoundsWithIndex: start direction: #for.
  238.     self selectionStartIndex: wordIndices last.
  239.     self selectionStopIndex: wordIndices last.
  240.     view selectAndScroll.
  241.     ^true!
  242.  
  243. helpKey: aChar
  244.     | c purpose |
  245.     c := self sensor keyboardEvent.
  246.     purpose := self dispatchTable lookup: c keyValue meta: c metaState.
  247.     purpose = #echoInputKey: ifTrue: [purpose := ' not used '].
  248.     DialogView warn: c keyValue printString, ' ', purpose.!
  249.  
  250. indentedCRKey: aChar
  251.     "Replace the current text selection with a CR plus 
  252.     the number of tabs and spaces found at the beginning of 
  253.     the current line."
  254.     "Based on a (rather inefficient) version from ParcPlace."
  255.  
  256.     | text index character characterStream ssi |
  257.  
  258.     "Sniff backwards along text string till CR or beginning of string."
  259.     text := self paragraph text.
  260.     index := ssi := self selectionStartIndex.
  261.     "test for empty text"
  262.     index = 1 ifTrue: [self appendToSelection: (String with: CR).  ^self].
  263.     character := nil.
  264.     [index := index - 1.
  265.     character := text at: index.
  266.     character = CR or: [index = 1]]
  267.         whileFalse.
  268.  
  269.     "Special exit for immediate encounter of CR."
  270.     (ssi - 1 = index)
  271.         ifTrue: [self appendToSelection: (String with: CR).  ^self].
  272.  
  273.     "Now accumulate whitespace into characterStream till first non-white  
  274.     character, or end of string."
  275.     characterStream := (String new: 8) writeStream.
  276.     characterStream nextPut: CR.
  277.     character == CR ifTrue: [index := index + 1].
  278.     character := text at: index.
  279.     [character = Tab | (character = Space) & (index < ssi)]
  280.         whileTrue: 
  281.             [characterStream nextPut: character.
  282.             index := index + 1.
  283.             index < ssi ifTrue: [character := text at: index]].
  284.     self appendToSelection: characterStream contents!
  285.  
  286. inspectItKey: aChar
  287.     self inspectIt!
  288.  
  289. printItKey: aChar
  290.     self printIt!
  291.  
  292. selectWordKey: aChar
  293.     | s |
  294.     s := self selectWord: self selectionStartIndex.
  295.     self selectFrom: s first to: s last! !
  296.  
  297. !ParagraphEditor methodsFor: 'private - editing'!
  298.  
  299. getWordBoundsWithIndex: index direction: aSymbol
  300.     ".Creator: Markus Geltz        Last Modified:  14 October 1991  12:36:26 pm."
  301.     "returns the word bounds of the word next to index anInteger. direction should
  302.     be the symbol #back or #for"
  303.  
  304.     | direction level string here hereChar start |
  305.     string := self text string.
  306.     here := index.
  307.     aSymbol = #back
  308.         ifTrue: [direction := -1]
  309.         ifFalse: [direction := 1].
  310.     [hereChar := string at: (here := here + direction).
  311.     hereChar isAlphaNumeric not]
  312.         whileTrue.
  313.     direction := -1.
  314.     level := 1.
  315.     [level > 0 and: [direction > 0
  316.             ifTrue: [here < string size]
  317.             ifFalse: [here > 1]]]
  318.         whileTrue: 
  319.             [hereChar := string at: (here := here + direction).
  320.             "token scan goes left, then right"
  321.             hereChar tokenish
  322.                 ifTrue: [here = 1
  323.                         ifTrue: 
  324.                             [start := 1.
  325.                             "go right if hit string start"
  326.                             direction := 1]]
  327.                 ifFalse: [direction < 0
  328.                         ifTrue: 
  329.                             [start := here + 1.
  330.                             "go right if hit non-token"
  331.                             direction := 1]
  332.                         ifFalse: [level := 0]]].
  333.     level > 0 ifTrue: ["in case ran off string end"    here := here + direction].
  334.     ^ start to: here! !
  335.  
  336.  
  337. !ParagraphEditor class methodsFor: 'class initialization'!
  338.  
  339. expandDispatchTable
  340.     ".Creator: Markus Geltz        Last Modified:  4 November 1991  3:56:46 pm."
  341.     "expand the keyboard dispatch table"
  342.     "ParagraphEditor expandDispatchTable."  
  343.     (DialogView confirm: 'Do you want ctrl/t and ctrl/f to be flip and forward?')
  344.         ifFalse: [^self].
  345.     Keyboard bindValue: #homeKey: to: Ctrla.
  346.     Keyboard bindValue: #deleteForwardCharKey: to: Ctrld.
  347.     Keyboard bindValue: #endKey: to: Ctrle.
  348.     Keyboard bindValue: #cursorRightKey: to: Ctrlf.
  349.     Keyboard bindValue: #cursorLeftKey: to: Ctrlb.
  350.     Keyboard bindValue: #cursorUpKey: to: Ctrlp.
  351.     Keyboard bindValue: #cursorDownKey: to: Ctrln.
  352.     Keyboard bindValue: #beginOfTextKey: to: ESC followedBy: $<.
  353.     Keyboard bindValue: #endOfTextKey: to: ESC followedBy: $>.
  354.     Keyboard bindValue: #flipCharsKey: to: Ctrlt.
  355.  
  356.     Keyboard
  357.         bindValue: #forwardWordKey:
  358.         to: ESC
  359.         followedBy: $f.
  360.     Keyboard
  361.         bindValue: #backWordKey:
  362.         to: ESC
  363.         followedBy: $b.
  364.     Keyboard
  365.         bindValue: #deleteForwardWordKey:
  366.         to: ESC
  367.         followedBy: $d.
  368.     Keyboard
  369.         bindValue: #deleteBackwardWordKey:
  370.         to: ESC
  371.         followedBy: Cut!
  372.  
  373. initialize
  374.     "Initialize the yellow button menu information, the keyboard map for special
  375.     control characters, and the shared buffers for copying text across views and
  376.     managing undo."
  377.  
  378.     "ParagraphEditor initialize."
  379.     PreviousSelections := OrderedCollection with: ' ' asText.
  380.     self currentSelection: (self undoSelection: Text new).
  381.     TextEditorYellowButtonMenu := 
  382.         PopUpMenu labels: 'again\undo\copy\cut\paste\accept\cancel' withCRs
  383.                     lines: #(2 5 )
  384.                     values: #(again undo copySelection cut paste accept cancel).
  385.     CodeYellowButtonMenu := 
  386.         PopUpMenu 
  387.             labelList: #((again undo) (copy cut paste) ('do it' 'print it' 'inspect') (accept cancel) (hardcopy))
  388.             values: #(again undo copySelection cut paste doIt printIt inspectIt accept cancel hardcopy).
  389.     MostRecentSearchString := ''.
  390.     self initializeDispatchTable.
  391.     self expandDispatchTable.
  392.     self initializeSUNKeys.
  393.     CompilationErrorSignal := (self errorSignal newSignalMayProceed: true)
  394.         notifierString: 'Compilation failed';
  395.         nameClass: self message: #compilationErrorSignal.!
  396.  
  397. initializeDispatchTable
  398.     "Initialize the keyboard dispatch table."
  399.     "ParagraphEditor initializeDispatchTable."
  400.  
  401.     Keyboard := DispatchTable new. 
  402.  
  403.     Keyboard defaultForCharacters: #normalCharacterKey:.
  404.     Keyboard defaultForNonCharacters: #echoInputKey:.
  405.  
  406.     Keyboard bindValue: #backspaceKey: to: Cut.
  407.     Keyboard bindValue: #pasteKey: to: Paste.
  408.     Keyboard bindValue: #backspaceKey: to: BS.
  409.     Keyboard bindValue: #backWordKey: to: Ctrlw.
  410.  
  411.     Keyboard bindValue: #displayIfTrueKey: to: Ctrlt.
  412.     Keyboard bindValue: #displayIfFalseKey: to: Ctrlf.
  413.     Keyboard bindValue: #displayDateKey: to: Ctrld.
  414.     Keyboard bindValue: #displayColonEqualKey: to: Ctrlg.
  415.  
  416.     "Keyboard bindValue: #displayCRKey: to: #Enter."
  417.  
  418.     Keyboard bindValue: #cursorUpKey: to: #Up.
  419.     Keyboard bindValue: #cursorDownKey: to: #Down.
  420.     Keyboard bindValue: #cursorLeftKey: to: #Left.
  421.     Keyboard bindValue: #cursorRightKey: to: #Right.
  422.  
  423.     Keyboard bindValue: #homeKey: to: #Home.
  424.     Keyboard bindValue: #endKey: to: #End.
  425.     Keyboard bindValue: #pageUpKey: to: #PageUp.
  426.     Keyboard bindValue: #pageDownKey: to: #PageDown.
  427.  
  428.     '<''"[{(' do:
  429.         [:char |
  430.         Keyboard
  431.             bindValue: #encloseKey:
  432.             to: ESC
  433.             followedBy: char].
  434.     'sSuUbBiIx+-' do:
  435.         [:char |
  436.         Keyboard
  437.             bindValue: #changeEmphasisKey:
  438.             to: ESC
  439.             followedBy: char].
  440.     Keyboard
  441.         bindValue: #miniFormatKey:
  442.         to: ESC
  443.         followedBy: $f.
  444.     Keyboard
  445.         bindValue: #selectCurrentTypeInKey:
  446.         to: ESC
  447.         followedBy: Tab.
  448.     Keyboard
  449.         bindValue: #selectCurrentTypeInKey:
  450.         to: #F1!
  451.  
  452. initializeSUNKeys
  453.     "Initialize the mapping for function keys on the SUN type-4 keyboard."
  454.     "ParagraphEditor initializeSUNKeys"
  455.     Keyboard bindValue: #indentedCRKey: to: LF.
  456.     Keyboard bindValue: #againKey: to: #L2.
  457.     Keyboard bindValue: #undoKey: to: #L4.
  458.     Keyboard bindValue: #copySelectionKey: to: #L6.
  459.     Keyboard bindValue: #pasteKey: to: #L8.
  460.     Keyboard bindValue: #cutKey: to: #L10.
  461.     Keyboard bindValue: #doItKey: to: #R1.
  462.     Keyboard bindValue: #printItKey: to: #R2.
  463.     Keyboard bindValue: #inspectItKey: to: #R3.
  464.     Keyboard bindValue: #acceptKey: to: #Enter.
  465.     Keyboard bindValue: #homeKey: to: #R7.
  466.     Keyboard bindValue: #endKey: to: #R13.
  467.     Keyboard bindValue: #pageUpKey: to: #R9.
  468.     Keyboard bindValue: #pageDownKey: to: #R15.
  469.     Keyboard bindValue: #findKey: to: #L9.
  470.     Keyboard bindValue: #selectWordKey: to: #R11.
  471.     Keyboard bindValue: #helpKey: to: #Help.! !
  472.  
  473. ParagraphEditor initialize!
  474.  
  475.  
  476. ParagraphEditor subclass: #KeyStrokeMonitor
  477.     instanceVariableNames: ''
  478.     classVariableNames: ''
  479.     poolDictionaries: ''
  480.     category: 'Interface-Text'!
  481.  
  482.  
  483. !KeyStrokeMonitor methodsFor: 'editing'!
  484.  
  485. readKeyboard
  486.     "Read the keyboard and dispatch the keyboard events."
  487.  
  488.     "This method checks the Symbol returned by the dispatchTable and checks to see if it is
  489.     "
  490.     self deselect.
  491.     self sensor keyboardPressed     ifTrue:
  492.         [
  493.         self dispatchTable
  494.             add: self sensor keyboardEvent do:
  495.                 [:charEvent :sel | self selectFrom: 1 to: self text string size + 1.
  496.                         self performPasteAction: charEvent keyValue printString
  497.         ]].
  498.     view selectAndScroll! !
  499.  
  500. !KeyStrokeMonitor methodsFor: 'plugging'!
  501.  
  502. menu
  503.     ^PopUpMenu labels: 'ceci n''est pas une carte'!
  504.  
  505. starttext
  506.     ^ ''! !
  507. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  508.  
  509. KeyStrokeMonitor class
  510.     instanceVariableNames: ''!
  511.  
  512.  
  513. !KeyStrokeMonitor class methodsFor: 'instance creation'!
  514.  
  515. open
  516.     "KeyStrokeMonitor open"
  517.     "Use this to see what codes to set in the ParagraphEditor dispatch table
  518.     --- each keystroke typed at this window shows its key value."
  519.     | km dc tv win |
  520.     km := self new.
  521.     dc := DependentComposite new.
  522.     tv := TextView on: km aspect: #starttext change: #t:from: menu: #menu initialSelection: nil.
  523.     dc add: (LookPreferences edgeDecorator on: tv) in: (0@0 corner: 1.0@1.0).
  524.     tv controller: km.
  525.     win := ScheduledWindow model: km label: 'KB Monitor' minimumSize: 110@30.
  526.     win maximumSize: win minimumSize.
  527.     win component: dc. 
  528.     win open.
  529.     ^self! !
  530.